home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MYUTIL / AUTOSER1.M < prev    next >
Encoding:
Text File  |  1989-03-10  |  9.7 KB  |  343 lines
  1. MODULE Serialize;
  2.  
  3. (*    =======================================
  4.        Vertraulich! Keinesfalls weitergeben!
  5.       =======================================
  6.    
  7.       Seriennummern im Compiler eintragen
  8.         
  9.       17.11.87  jm   /0.0/  Suchen der Seriennummern
  10.       15.12.87  jm   /1.0/  lauffähige Version
  11.       29.02.88  jm   /1.1/  neues Schlüsselverfahren mit Offset
  12.      
  13. *)
  14.  
  15. FROM Files   IMPORT File, Open, Create, Close, Remove, State,
  16.                     Access, ReplaceMode;
  17. FROM Binary  IMPORT SeekMode, Seek, ReadBytes, ReadWord, WriteWord, FileSize;
  18. FROM Paths   IMPORT PathList, StdPaths, SearchFile, ListPos;
  19. FROM InOut   IMPORT WriteString, FlushKbd, BusyRead, WriteLn, Read, WriteCard, 
  20.  ReadCard, WriteHex;
  21. FROM Storage IMPORT ALLOCATE;
  22. FROM Strings IMPORT Concat;
  23. FROM StrConv IMPORT CardToStr;
  24. FROM SYSTEM  IMPORT ADDRESS;
  25. FROM PrgCtrl IMPORT TermProcess;
  26.  
  27.  
  28. CONST   compname = 'A:\M2.MOD';       (* Name des Codefiles *)
  29.           NrKeys = 2;                 (* Anzahl verschiedener Schlüssel *)
  30.         maxCount = 10;                (* max. Anzahl Referenzen pro Nummer *)
  31.  
  32. TYPE     PosList = ARRAY [1..maxCount] OF LONGCARD;
  33.  
  34. VAR
  35.             value,                    (* Werte der Default-Seriennummern *)
  36.              lead,                    (* LeadIn-Worte   -"-              *)
  37.          expCount,                    (* erwartete Anzahl der Vorkommen  *)
  38.             patch: ARRAY [0..NrKeys] OF CARDINAL;
  39.           offsets: ARRAY [0..NrKeys] OF PosList;
  40.  
  41.              Offs,
  42.            RegLen,
  43.          FeedBack,
  44.           Iterate: ARRAY [1..NrKeys] OF CARDINAL;
  45.  
  46.  
  47. PROCEDURE err (s: ARRAY OF CHAR; fatal: BOOLEAN);
  48.   VAR c: CHAR;
  49.   BEGIN
  50.     WriteLn; WriteString ('>> '); WriteString (s); WriteLn;
  51.     IF fatal THEN
  52.       Read (c); TermProcess (1);
  53.     END
  54.   END err;
  55.   
  56.  
  57. PROCEDURE ReadCompiler (VAR a: ADDRESS; VAR size: LONGCARD;
  58.                          name: ARRAY OF CHAR): BOOLEAN;
  59.   
  60.   (* Sucht Datei <name> auf DefaultPath,
  61.      reserviert Speicher und liest Datei ein.
  62.      <a>    := Anfangsadresse der Datei im Speicher;
  63.      <size> := Länge  -"- .
  64.      Ergebnis := 'Datei gefunden, genug Platz zum Einlesen gehabt'
  65.   *)
  66.   
  67.   VAR         f: File;
  68.              ok: BOOLEAN;
  69.            path: PathList;
  70.            read: LONGCARD;
  71.        realname: ARRAY [0..127] OF CHAR;
  72.        
  73.   BEGIN
  74.     path := StdPaths();
  75.     SearchFile (name, path, fromStart, ok, realname);
  76.     IF NOT ok THEN RETURN FALSE END;
  77.     Open (f, realname, readOnly);
  78.     size := FileSize (f);
  79.     ALLOCATE (a, size);
  80.     IF a = NIL THEN RETURN FALSE END;
  81.     ReadBytes (f, a, size, read);
  82.     IF size # read THEN RETURN FALSE END;
  83.     Close (f);
  84.     RETURN TRUE
  85.   END ReadCompiler;
  86.  
  87.  
  88. PROCEDURE Search (        a: ADDRESS; len: LONGCARD; targ1, targ2: CARDINAL;
  89.                   VAR count: CARDINAL;
  90.                     VAR pos: PosList);
  91.   BEGIN
  92.     ASSEMBLER
  93.       MOVE.L   pos(A6),A1
  94.       CLR.W    D3
  95.       MOVE.L   a(A6),A0
  96.       MOVE.L   len(A6),D1
  97.       MOVE.W   targ1(A6),D0
  98.       MOVE.W   targ2(A6),D4
  99.    
  100.    lp CMP.W    (A0)+,D0         ;Suchschleife
  101.       BNE      nix
  102.       CMP.W    (A0),D4
  103.       BNE      nix
  104.       MOVE.L   A0,D2
  105.       SUB.L    a(A6),D2
  106.       MOVE.L   D2,(A1)+
  107.       ADDQ.L   #1,D3
  108.   nix SUBQ.L   #2,D1
  109.       BHI      lp
  110.       
  111.       MOVE.L   count(A6),A0
  112.       MOVE.W   D3,(A0)          ;setze Count
  113.     END
  114.   END Search;
  115.  
  116.  
  117. PROCEDURE FindOffsets;
  118.   
  119.   (*  Liest Datei <compname> nach Suche auf DefaultPath.
  120.       Durchsucht nach Auftreten von <lead>, <value> und prüft
  121.       jeweils, ob <expcount> Vorkommen gefunden.
  122.       Bricht im Fehlerfall mit Meldung ab.
  123.   *)
  124.       
  125.   VAR   a: ADDRESS;
  126.         l: LONGCARD;
  127.  count, k: CARDINAL;
  128.    errmsg: ARRAY [0..127] OF CHAR;
  129.     dummy: BOOLEAN;
  130.   
  131.   BEGIN
  132.     IF ReadCompiler (a, l, compname) THEN
  133.       FOR k := 0 TO NrKeys DO
  134.         Search (a, l, lead [k], value [k], count, offsets [k]);
  135.         IF count # expCount [k] THEN
  136.           Concat ('Falsche Anzahl Schlüsseleinträge: ',
  137.                    CardToStr (count, 0), errmsg, dummy);
  138.           err (errmsg, TRUE)
  139.         END;
  140.       END
  141.     ELSE
  142.       err ('Compiler kann nicht gelesen werden!', TRUE)
  143.     END;
  144.   END FindOffsets;
  145.   
  146.   
  147. PROCEDURE encode (start, len, feedback, iter, off: CARDINAL): CARDINAL; (*$L-*)
  148.     
  149.   (* Schieberegister rechtsrum, Bits 0..<len>,
  150.      Rückkopplung aus Bit <feedback>, auf <start>-Wert loslassen.
  151.      <iter> Iterationen durchführen; <Off> addieren;
  152.      Ergebnis auf Cardinal kürzen
  153.   *)
  154.   
  155.   BEGIN
  156.     ASSEMBLER
  157.       MOVE.W  -(A3),D3        ;Offset
  158.       MOVE.W  -(A3),D2        ;Iterationen
  159.       MOVE.W  -(A3),D0        ;rückgeführtes Bit
  160.       MOVE.W  -(A3),D4        ;Registerlänge -1
  161.       CLR.L   D1
  162.       MOVE.W  -(A3),D1        ;Startwert
  163.       BRA     l1
  164.    l2 BTST    D0,D1           ;Bit0 := Bit0 EOR Bit(D0)
  165.       BEQ     nochg           ; "
  166.       BCHG    #0,D1           ; "
  167. nochg LSR.L   #1,D1           ;einmal rechts schieben
  168.       BCC     l1              ;und Bit0 in Bit(D4) rotieren
  169.       BSET    D4,D1
  170.    l1 DBF     D2,l2
  171.       ADD.W   D3,D1           ;Offset dazu
  172.       MOVE.W  D1,(A3)+        ;Ergebnis zurück
  173.     END
  174.   END encode;         (*$L+*)
  175.   
  176.   
  177. PROCEDURE CheckSer;
  178.  
  179.    (* prüft, ob die angegebenen Schlüsselverfahren konsistent
  180.       sind mit den angegebenen Default-Einträgen.
  181.       Im Fehlerfall Abbruch mit Meldung.
  182.    *)
  183.    
  184.    VAR  k: CARDINAL;
  185.    
  186.    BEGIN
  187.      FOR k := 1 TO NrKeys DO
  188.        IF encode (value[0], RegLen[k], FeedBack[k], Iterate[k], Offs[k])
  189.           # value [k]
  190.          THEN err ('Schlüsselverfahren paßt nicht zu Default-Einträgen', TRUE)
  191.        END
  192.      END
  193.    END CheckSer;
  194.    
  195.  
  196. PROCEDURE CalcSer (mySer: CARDINAL);
  197.   
  198.   (* Übergabe der Seriennummer in <mySer>.
  199.      Setzt ARRAY <patch> auf verschlüsselte Seriennummern.
  200.      Verwendet Beschreibung der Schlüsselverfahren in
  201.      <RegLen>, <FeedBack>, <Iterate>.           *)
  202.   
  203.   VAR  k: CARDINAL;
  204.   
  205.   BEGIN
  206.     patch [0] := mySer;
  207.     WriteString ('   Nr. '); WriteCard (mySer, 4);
  208.     WriteString ('   Schlüssel '); WriteHex (patch [0], 7);
  209.     FOR k := 1 TO NrKeys DO
  210.       patch [k] :=
  211.              encode (mySer, RegLen[k], FeedBack[k], Iterate[k], Offs [k]);
  212.       WriteHex (patch[k], 7);
  213.     END;
  214.     WriteLn;
  215.   END CalcSer;
  216.   
  217.   
  218. PROCEDURE OpenCompiler (VAR f: File; name: ARRAY OF CHAR): BOOLEAN;
  219.   
  220.   (* Sucht Datei <name> auf DefaultPath,
  221.      reserviert Speicher und liest Datei ein.
  222.      <a>    := Anfangsadresse der Datei im Speicher;
  223.      <size> := Länge  -"- .
  224.      Ergebnis := 'Datei gefunden, genug Platz zum Einlesen gehabt'
  225.   *)
  226.   
  227.   VAR       ok: BOOLEAN;
  228.            path: PathList;
  229.        realname: ARRAY [0..127] OF CHAR;
  230.        
  231.   BEGIN
  232.     path := StdPaths();
  233.     SearchFile (name, path, fromStart, ok, realname);
  234.     IF NOT ok THEN
  235.       err ('Datei nicht gefunden', FALSE); RETURN FALSE
  236.     END;
  237.     Open (f, realname, readWrite);
  238.     IF State (f) < 0 THEN
  239.       err ('Datei gefunden, aber nicht zu öffnen', FALSE); RETURN FALSE
  240.     END;
  241.     RETURN TRUE
  242.   END OpenCompiler;
  243.  
  244.  
  245. PROCEDURE PatchSerial (mySer: CARDINAL): BOOLEAN;
  246.   
  247.   VAR  j, k: CARDINAL;
  248.           f: File;
  249.           w: CARDINAL;
  250.           
  251.   BEGIN
  252.     CalcSer (mySer);
  253.     IF NOT OpenCompiler (f, compname) THEN
  254.       RETURN FALSE
  255.     END;
  256.     FOR j := 0 TO NrKeys DO
  257.       FOR k := 1 TO expCount [j] DO
  258.         Seek (f, offsets [j, k], fromBegin);
  259.         ReadWord (f, w);
  260.         IF w # value [j] THEN
  261.           IF (j=0) & (k=1) THEN
  262.             err ('Falsche Seriennummern gefunden: Datei unverändert', FALSE);
  263.             Close (f);
  264.           ELSE
  265.             err ('Falsche Seriennummern gefunden: Datei gelöscht', FALSE);
  266.             Remove (f);
  267.           END;
  268.           RETURN FALSE
  269.         END;
  270.         Seek (f, -2L, fromPos);
  271.         WriteWord (f, patch [j])
  272.       END
  273.     END;
  274.     Close (f);
  275.     RETURN TRUE
  276.   END PatchSerial;
  277.   
  278.   
  279. VAR   mySer, mySerE, i: CARDINAL;
  280.           c: CHAR;
  281.  
  282. BEGIN
  283.   
  284.   (* Konstanten für Schlüssel *)
  285.   
  286.   RegLen [1] := 17; FeedBack [1] := 7; Iterate [1] :=  39; Offs [1] := $2302;
  287.   RegLen [2] := 16; FeedBack [2] := 3; Iterate [2] := 367; Offs [2] := $3C78;
  288.    
  289.   (* Default-Seriennummern im Compiler *)
  290.   
  291.   value [0] := $4711;  expCount [0] := 3;  lead [0] := $0641;
  292.   value [1] := $1ADE;  expCount [1] := 1;  lead [1] := $343C;
  293.   value [2] := $312F;  expCount [2] := 1;  lead [2] := $0240;
  294.   
  295.   (* Seriennummern im Compiler suchen *)
  296.   
  297.   WriteString ('Serialize /1.1/:  Seriennummern in Compiler eintragen ');
  298.   WriteLn; WriteLn;
  299.   
  300.   WriteString ('Konsistenzprüfung der angegebenen Schlüssel:'); WriteLn;
  301.   CheckSer;
  302.   WriteString ('   ok.'); WriteLn; WriteLn;
  303.   
  304.   WriteString ('Suchen der Seriennummern:'); WriteLn;
  305.   WriteString ('   '); WriteString (compname);
  306.   WriteString (' auf DefaultPath ?'); WriteLn;
  307.   WriteString ('   Taste drücken!'); WriteLn;
  308.   Read (c);
  309.   
  310.   FindOffsets;
  311.   WriteString ('   ok.'); WriteLn; WriteLn;
  312.   
  313.   (* neue Seriennummern eintragen *)
  314.   
  315.   LOOP
  316.     WriteString ('Neue Seriennummer eintragen:'); WriteLn;
  317.     WriteString ('   '); WriteString (compname);
  318.     WriteString (' auf DefaultPath ?'); WriteLn;
  319.     WriteString ('   Start eingeben (0 stoppt): ');
  320.     ReadCard (mySer);
  321.     IF mySer = 0 THEN EXIT END;
  322.     WriteLn;
  323.     WriteString ('   Ende eingeben (0 stoppt) : ');
  324.     ReadCard (mySerE);
  325.     IF mySerE = 0 THEN EXIT END;
  326.     
  327.     FOR i:= mySer TO mySerE DO
  328.       FlushKbd;
  329.       WriteLn;
  330.       WriteString ('ESC stops, SPACE writes...');
  331.       REPEAT BusyRead (c) UNTIL (c=33C) OR (c=' ');
  332.       WriteLn;
  333.       IF c=33C THEN EXIT END;
  334.       IF PatchSerial (i) THEN
  335.         WriteString ('   ok.'); WriteLn;
  336.       END;
  337.     END;
  338.     WriteLn;
  339.   END;
  340.   
  341. END Serialize.
  342.  
  343.